home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #054 (1990)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #054 (1990)(Amiga User Group Deutschland e.V.).adf / PolygrammDemo / PGD.s < prev    next >
Text File  |  1989-07-02  |  24KB  |  928 lines
  1. **********************************************************
  2. *
  3. * This is Public Domain ! Do with it whatever you like !!!
  4. *
  5. **********************************************************
  6. ;
  7. ; PolygrammDemo.s : dreht ein beliebiges Polygramm um beliebige Achse
  8. ;                   Anzahl der Ecken sowie veraenderte Drehung sind
  9. ;                   im Quelltext zu aendern
  10. ;                   siehe ganz unten !!!
  11. ;
  12. ;
  13. ; Autor :      Sascha Groening
  14. ;              Blaustr.:    13
  15. ;              8360 Deggendorf
  16. ;              West-Germany
  17. ;
  18. ;
  19. ; das Programm wurde fuer den A68K  Public Domain Assembler
  20. ;                             BLINK Public Domain Linker      geschrieben
  21. ;
  22. ;                             (A68K : Fish Disk 110)
  23. ;                             (BLINK: Fish Disk  40)
  24. ;
  25. ;
  26. ;
  27. ;
  28. ; Nutzen:
  29. ;                 K E I N E R !
  30. ;
  31. ;
  32. ; Es ist ein Beispiel fuer flackerfreie Darstellung von bewegter
  33. ; Grafik durch verdecktes Aufbauen der Grafik in einem
  34. ; Bufferspeicher und anschliessendes Kopieren ins Window
  35. ;
  36. ; Ausserdem kann man es als Beispiel fuer die Benutzung von den Mathe
  37. ; Libraries benutzen.
  38. ; (Ihre Routinen sind zwar nicht besonders schnell,
  39. ;  das Ganze ist aber immer noch erheblich einfacher als sich die SIN & COS
  40. ;  Routinen selber zu schreiben)
  41. ;
  42. ;
  43. ;
  44. ; Assemblieren :      A68K  PolygrammDemo.s
  45. ;                     BLINK PolygrammDemo.o
  46. ;
  47. ;
  48. ;
  49. ; ACHTUNG : das Programm benoetigt die
  50. ;            -mathtrans.library
  51. ;           im LIBS: Directory
  52. ;
  53. ;
  54. ;
  55. ; (Das Programm ist in Spagetti-Technik aufgebaut
  56. ;  also Schritt fuer Schritt gut nachvollziehbar!
  57. ;  (um es mal positiv auszudruecken))
  58. ;
  59.  
  60.  
  61.  
  62. CALLDOS  macro
  63.          movea.l DOSBase,a6
  64.          jsr    \1(a6)
  65.          endm
  66.  
  67. CALLEXEC macro
  68.          movea.l SysBase,a6
  69.          jsr    \1(a6)
  70.          endm
  71. CALLINT  macro
  72.          movea.l IntBase,a6
  73.          jsr    \1(a6)
  74.          endm
  75. CALLGRAF macro
  76.          movea.l GfxBase,a6
  77.          jsr    \1(a6)
  78.          endm
  79. CALLMATH macro
  80.          movea.l MathBase,a6
  81.          jsr     \1(a6)
  82.          endm
  83. CALLMATHTRANS macro
  84.               movea.l MathTransBase,a6
  85.               jsr     \1(a6)
  86.               endm
  87.  
  88. SysBase   equ 4
  89. OldOpenLibrary equ -408
  90. CloseLibrary equ -414
  91. GetMsg equ -372
  92. ReplyMsg equ -378
  93. FreeMem equ -210
  94. AllocMem equ -198
  95.  
  96. Output equ -60
  97. Write equ -48
  98. Delay equ -198
  99.  
  100. CloseWindow equ -72
  101. OpenWindow equ -204
  102.  
  103. BltBitMap equ -30
  104. SetRast equ -234
  105. Move equ -240
  106. PolyDraw equ -336
  107. SetAPen equ -342
  108. AllocRaster equ -492
  109. FreeRaster equ -498
  110. InitBitMap equ -390
  111. ScrollRaster equ -396
  112. InitRastPort equ -198
  113. Text equ -60
  114. DrawEllipse equ -180
  115. WaitTOF equ -270
  116.  
  117. SPFix equ -30
  118. SPFlt equ -36
  119. SPCmp equ -42
  120. SPNeg equ -60
  121. SPAdd equ -66
  122. SPSub equ -72
  123. SPMul equ -78
  124. SPDiv equ -84
  125. SPAtan equ -30
  126. SPSin equ -36
  127. SPCos equ -42
  128.  
  129.  
  130. MEMF_CHIP equ $2
  131. MEMF_CLEAR   equ $10000
  132.  
  133.  
  134. wd_RPort     equ $32
  135. wd_UserPort  equ $56
  136. MP_SIGBIT    equ $0f
  137.  
  138. rp_BitMap equ 4
  139. bm_Plane0 equ 8
  140. bm_Plane1 equ 12
  141. bm_Plane2 equ 14
  142.  
  143.  
  144. WINDOWDRAG     equ $0002
  145. WINDOWDEPTH    equ $0004
  146. WINDOWCLOSE    equ $0008
  147. SMART_REFRESH  equ $0000
  148. ACTIVATE       equ $1000
  149. CLOSEWINDOW    equ $00000200
  150. WBENCHSCREEN   equ $0001
  151.  
  152.  
  153.  
  154. **********************************
  155. ;               MainProg
  156. **********************************
  157.  
  158. _main
  159.    move.l a7,stapel
  160.  
  161.    lea.l    dosname,a1
  162.    CALLEXEC OldOpenLibrary   ;dos.library oeffnen
  163.    move.l   d0,DOSBase
  164.    beq      abbruch
  165.  
  166.    CALLDOS Output
  167.    move.l d0,OutHandle
  168.  
  169. ;   move.l #_main,d2
  170. ;   lea.l  hbuf,a0
  171. ;   move.b #10,8(a0)
  172. ;   bsr    hexasc
  173. ;   move.l OutHandle,d1
  174. ;   move.l #hbuf,d2
  175. ;   move.l #9,d3
  176. ;   CALLDOS Write             ;Anfangsadr des Prgs ausgeben
  177.  
  178.    lea.l  intname,a1
  179.    CALLEXEC OldOpenLibrary
  180.    move.l d0,IntBase         ;intuition.library oeffnen
  181.    beq    closedos
  182.  
  183.    lea.l  grafname,a1
  184.    CALLEXEC OldOpenLibrary   ;graphics.library oeffnen
  185.    move.l d0,GfxBase
  186.    beq    closeint
  187.  
  188.    lea.l  mathname,a1
  189.    CALLEXEC OldOpenLibrary   ;mathffp.library oeffnen
  190.    move.l d0,MathBase
  191.    beq    nomath
  192.  
  193.    lea.l  mathtransname,a1
  194.    CALLEXEC OldOpenLibrary   ;mathtrans.library oeffnen
  195.    move.l d0,MathTransBase
  196.    beq    nomathtrans
  197.  
  198.    lea.l    windowdef,a0
  199.    CALLINT  OpenWindow       ;window oeffnen
  200.    move.l   d0,windowptr
  201.    beq      closemathtrans
  202.  
  203.    movea.l d0,a0
  204.    move.l wd_UserPort(a0),UPort   ;UserPort holen
  205.    move.l wd_RPort(a0),RPort      ;RastPort holen
  206.  
  207.    movea.l RPort,a3
  208.    movea.l rp_BitMap(a3),a3
  209.    move.l  a3,DestBitMap          ;die BitMapstrktr des Windows holen
  210.  
  211.    movea.l a3,a0
  212.    moveq.l #2,d0
  213.    move.l #630,d1
  214.    move.l #240,d2
  215.    CALLGRAF InitBitMap          ;richtige Werte fordern
  216.  
  217.    move.l bm_Plane0(a3),Plane0  ;dieselbigen holen
  218.    move.l bm_Plane1(a3),Plane1  ;(just for fun !!)
  219.  
  220. * 2 BufferPlanes allokieren und sie in unsere eigene Bitmapstrktr
  221. *                      eintragen
  222. *----------------------------------------------------------------
  223.  
  224.    move.l #384,d0
  225.    move.l #172,d1
  226.    CALLGRAF AllocRaster
  227.    move.l d0,Buffer0     ;Plane0 in Bitmapstrktr eintragen
  228.    beq    nomem
  229.  
  230.    move.l #384,d0
  231.    move.l #172,d1
  232.    CALLGRAF AllocRaster
  233.    move.l d0,Buffer1     ;Plane1 in Bitmapstrktr eintragen
  234.    beq    nomem
  235.  
  236. * eigenen RastPort initialisieren, damit wir auch in die Bufferplane
  237. * zeichnen koennen
  238. * ------------------------------------------------------------------
  239.  
  240.    lea.l OwnRastPort,a1
  241.    CALLGRAF InitRastPort  ;eigenen RastPort mit bestimmten
  242.                           ;Ausgangswerten initialisieren
  243.  
  244.    lea.l OwnBitMap,a0
  245.    lea.l OwnRastPort,a1
  246.  
  247.    move.l a0,rp_BitMap(a1) ;Bitmapstrktr in RastPort eintragen
  248.  
  249. * Planes loeschen
  250. * ---------------
  251.  
  252.    clr.l d0
  253.    lea.l OwnRastPort,a1
  254.    CALLGRAF SetRast
  255.  
  256. * Zeichenfarbe fuer window und Bufferplanes setzen
  257. * ------------------------------------------------
  258.  
  259.    lea.l OwnRastPort,a1
  260.    moveq.l #1,d0
  261.    CALLGRAF SetAPen          ;Zeichenfarbe fuer Window setzen
  262.  
  263.    movea.l RPort,a1
  264.    moveq.l #1,d0
  265.    CALLGRAF SetAPen          ;Zeichenfarbe fuer Window setzen
  266.  
  267.  
  268.  
  269. * Text im Fenster zeichnen
  270. * ------------------------
  271.    moveq.l #10,d2 ;XStart
  272.    moveq.l #20,d3 ;YStart
  273.    moveq.l #23,d4 ;Anzahl der Zeilen -1
  274.  
  275. loop1
  276.    move.l d2,d0
  277.    move.l d3,d1
  278.    movea.l  RPort,a1
  279.    CALLGRAF Move
  280.  
  281.    lea.l  msg,a0
  282.    moveq.l #msglen,d0
  283.    movea.l RPort,a1
  284.    CALLGRAF Text       ;eine Zeile ausgeben
  285.  
  286.    addi.l #8,d3        ;Y=Y+8
  287.  
  288.    dbra   d4,loop1     ;naechste Zeile
  289.  
  290.  
  291.  
  292. * Text im Fenster scrollen
  293. * ------------------------
  294.    moveq.l #25,d6   ;26 mal scrollen
  295.  
  296. loop2
  297.    moveq.l #-8,d0   ;dx
  298.    moveq.l #16,d1   ;dy
  299.    moveq.l #20,d2   ;xmin
  300.    moveq.l #28,d3   ;ymin
  301.    move.l  #400,d4  ;xmax
  302.    move.l  #200,d5  ;ymax
  303.    movea.l RPort,a1       ;_______________________________________________
  304.    CALLGRAF ScrollRaster  ;x(0/0)       Verschiebung um (dx/dy) Richtung |
  305.                           ;           \  Nullpunkt (0/0)                 |
  306.                           ;            \                                 |
  307.                           ;             \                                |
  308.                           ;              \ (xmin/ymin)                   |
  309.                           ;               x________                      |
  310.                           ;               |        |                     |
  311.                           ;               |        |                     |
  312.                           ;               |________x(xmax/ymax)          |
  313.                           ;                                              |
  314.                           ;______________________________________________|
  315.  
  316.    dbra    d6,loop2
  317.  
  318. * Ellipse zeichnen
  319. * ----------------
  320.  
  321.    movea.l RPort,a1      ;Polygramme werden in Ellipsen einbeschrieben
  322.    move.l #200,d0
  323.    move.l #100,d1        ;in diese Ellipse wird das 1.Polygramm
  324.    move.l rx,d2          ;einbeschrieben
  325.    move.l ry,d3
  326.    CALLGRAF DrawEllipse
  327.  
  328. ********************************************
  329. * Jetzt kommts ........
  330. ********************************************
  331.  
  332.  
  333. * PI berechnen
  334. * ------------
  335.  
  336.    move.l #$4,d0
  337.    CALLMATH SPFlt    ;4 in FFP Format umwandeln
  338.    move.l d0,-(a7)   ;FFP = Fast Floating Point (oder so aehnlich)
  339.                      ;(wobei das Fast nicht woertlich zu nehmen
  340.                      ; sondern galaktisch zu sehen ist )
  341.    move.l #$1,d0
  342.    CALLMATH SPFlt    ;1 --> FFP
  343.    CALLMATHTRANS SPAtan
  344.    move.l (a7)+,d1   ;d0 = ATN(1)
  345.    CALLMATH SPMul    ;4*ATN(1)
  346.                      ;*******************************
  347.    move.l d0,PI      ;PI = 4*ATN(1)
  348.                      ;*******************************
  349.  
  350.  
  351. * Argh berechnen  (Argh ist eine spezielle Konstante )
  352. * ----------------------------------------------------
  353. *                 (die zur Berechnung von ALPHA dient)
  354. *
  355.  
  356.    moveq.l #2,d0
  357.    CALLMATH SPFlt
  358.    move.l d0,two    ;2 in FFP wird noch oefter verwendet
  359.                     ;==> speichern
  360.  
  361.    move.l PI,d0
  362.    move.l two,d1
  363.    CALLMATH SPDiv   ;==> d0 = PI/2
  364.                     ;       = 90° in RAD (wie ja jedermann weiss)
  365.                     ;RAD wird benoetigt ,da es die
  366.                     ;Mathe Routinen in den Libraries so wollen
  367.  
  368.  
  369.    move.l d0,stepxcount  ;beginne Darstellung wenn Polygramm bereits
  370.                          ;um 90° um X- & Z-Achse gedreht wurde
  371.    move.l d0,stepzcount
  372.  
  373.  
  374.    moveq.l #1,d0
  375.    CALLMATH SPFlt   ;==> d0 = 1 in FFP Format
  376.    move.l two,d1
  377.    CALLMATH SPDiv   ;==> d0 = 1/2 in FFP Format
  378.    move.l d0,-(a7)  ;0.5 in FFP
  379.  
  380.    move.l n,d0
  381.    CALLMATH SPFlt   ;n-Eckiges-Polygramm
  382.    move.l two,d1
  383.    CALLMATH SPDiv   ;==> d0 = n/2
  384.    move.l (a7)+,d1  ;d0 = 0.5 in FFP Format
  385.    CALLMATH SPSub
  386.                     ;************************
  387.    move.l d0,argh   ;argh = d0 = n/2-0.5
  388.                     ;************************
  389.  
  390. * ALPHA berechnen   (ist ebenfalls eine Konstante)
  391. * -------------------------------------------------
  392. *                   (die zur Berechnung des Drehungswinkels um
  393. *                    die Y-Achse benoetigt wird)
  394.  
  395.  
  396.    move.l two,d0
  397.    move.l PI,d1
  398.    CALLMATH SPMul
  399.                     ;************************
  400.    move.l d0,PI2    ;PI2 = 2 * PI
  401.                     ;************************
  402.    move.l n,d0
  403.    CALLMATH SPFlt   ;==> n in FFP Format
  404.    move.l d0,d1
  405.    move.l PI2,d0
  406.    CALLMATH SPDiv   ;==> d0 = 2*PI/n
  407.    move.l argh,d1
  408.    CALLMATH SPMul   ;**********************************************
  409.    move.l d0,ALPHA  ;==> ALPHA = d0 = 2*PI/n*argh
  410.                     ;               = 2*PI/n*(n/2-0.5)
  411.                     ;                 2*PI    /  n          \
  412.                     ;               = ---- * |  ---  -  0.5  |
  413.                     ;                  n      \  2          /
  414.                     ;**********************************************
  415.  
  416.  
  417. * rx,ry,xpos,ypos in FFP umwandeln
  418. * ---------------------------------
  419.  
  420.    move.l rx,d0
  421.    CALLMATH SPFlt
  422.    move.l d0,rxffp  ;X-Radius der Ellipse --> FFP
  423.    move.l d0,lxffp
  424.  
  425.    move.l ry,d0
  426.    CALLMATH SPFlt
  427.    move.l d0,ryffp  ;Y-Radius der Ellipse --> FFP
  428.    move.l d0,lyffp
  429.  
  430.    move.l xpos,d0
  431.    CALLMATH SPFlt
  432.    move.l d0,xposffp  ;Mittelpunkt der Ellipse --> FFP
  433.  
  434.    move.l ypos,d0
  435.    CALLMATH SPFlt
  436.    move.l d0,yposffp  ;Mittelpunkt der Ellipse --> FFP
  437.  
  438. * stepx,-y,-z in RAD und FFP umrechnen
  439. * ------------------------------------
  440.  
  441. * stepy berechnen
  442. * ----------------
  443.  
  444.    move.l #180,d0
  445.    CALLMATH SPFlt
  446.    move.l d0,einsachtzig  ;180 --> FFP Format
  447.  
  448.    move.l stepy,d0
  449.    CALLMATH SPFlt         ;*****************************************
  450.    move.l einsachtzig,d1  ;         stepy         ;  Umwandlung von
  451.    CALLMATH SPDiv         ; stepy = -----  * PI   ;  Grad in RAD
  452.    move.l PI,d1           ;          180°         ;
  453.    CALLMATH SPMul         ;*****************************************
  454.    move.l d0,stepy        ;in stepy Grad Schritten um Y-Achse drehen
  455.  
  456. * stepx berechnen
  457. * ---------------
  458.  
  459.    move.l stepx,d0
  460.    CALLMATH SPFlt         :*****************************************
  461.    move.l einsachtzig,d1  ;         stepx
  462.    CALLMATH SPDiv         ; stepx = ----- * PI
  463.    move.l PI,d1           ;          180°
  464.    CALLMATH SPMul         ;*****************************************
  465.    move.l d0,stepx        ;in stepx Grad Schritten um Y-Achse drehen
  466.  
  467. * stepz berechnen
  468. * ----------------
  469.  
  470.    move.l stepz,d0
  471.    CALLMATH SPFlt         ;*****************************************
  472.    move.l einsachtzig,d1  ;         stepz
  473.    CALLMATH SPDiv         ; stepz = ----- * PI
  474.    move.l PI,d1           ;          180°
  475.    CALLMATH SPMul         ;*****************************************
  476.    move.l d0,stepz        ;in stepz Grad Schritten um Y-Achse drehen
  477.  
  478.  
  479.  
  480. * Mem fuer Vektor-Array allokieren
  481. * --------------------------------
  482.  
  483.    move.l n,d0   ; n Ecken ==> n+1 XY-Paare
  484.    addq.l #1,d0  ;             ==> (n+1)*4 Byte Speicher benoetigt
  485.    lsl.l #2,d0   ;   (ein Punkt benoetigt 1 Word fuer die X - Koordinate
  486.                  ;                      und eins fuer die Y - Koordinate
  487.                  ;
  488.                  ;   1.Punkt = letzter Punkt ==> +1
  489.  
  490.    move.l #MEMF_CHIP!MEMF_CLEAR,d1
  491.    CALLEXEC AllocMem     ;in dieses Array werden alle Koordinaten
  492.    move.l d0,VArray      ;der Ecken eines Polygramms eingetragen
  493.    beq    nomem
  494.  
  495. * n.Koord berechnen
  496. * -----------------
  497.  
  498. loop6
  499.    move.l VArray,a2  ;a2 = Speicher fuer Vektoren
  500.    move.l n,d5       ;d5 = n = Anzahl der Ecken
  501.    clr.l  d4         ;d4 = 0 = 1.Ecke
  502.  
  503. loop4
  504.    bsr  getxcoord    ; fuer jede Ecke X-,Y-Koordinate errechnen
  505.    bsr  getycoord    ;
  506.  
  507.    addq.l #1,d4      ;Ecke++
  508.    dbra   d5,loop4   ;naechste Ecke berechnen
  509.  
  510. * neues Polygramm zeichnen
  511. * -------------------------
  512.  
  513.  
  514.                       ; 1.Punkt = letzter Punkt
  515.                       ; ==>
  516.    move.w -4(a2),d0   ;x - Koord. des ersten Punktes
  517.    move.w -2(a2),d1   ;y - Koord. des ersten Punktes
  518.    lea.l OwnRastPort,a1
  519.    CALLGRAF Move      ; GrafikCursor an AnfangsPosition
  520.                       ;    (1.Ecke)
  521.  
  522.    CALLGRAF WaitTOF   ;vielleicht nuetzt es was ,vielleicht auch nicht
  523.  
  524.    lea.l OwnRastPort,a1
  525.    movea.l VArray,a0
  526.    move.l  n,d0
  527.    addq.l  #1,d0      ;d0 = Anzahl der zu zeichnenden Punkte
  528.    CALLGRAF PolyDraw  ;  ==> Punkte werden durch Linien verbunden
  529.  
  530.    movem.l d0-d7/a0-a3,-(a7)
  531.  
  532.    lea.l OwnBitMap,a0
  533.    movea.l DestBitMap,a1
  534.    clr.l d0              ;Srcx
  535.    clr.l d1              ;SrcY
  536.    move.w destx,d2
  537.    move.w desty,d3
  538.    move.l #380,d4        ;sizex
  539.    move.l #170,d5        ;sizey
  540.    move.b #$c0,d6        ;vanillacopy
  541.    move.b #$ff,d7        ;alle Bits gesetzt ==> alle verfuegbaren
  542.                          ;Planes kopieren
  543.    CALLGRAF BltBitMap    ;BufferBitmap ins Window kopieren
  544.  
  545.    movem.l (a7)+,d0-d7/a0-a3
  546.  
  547. * einige Zeit warten oder besser doch nicht!!!
  548. * -----------------------------------------
  549.  
  550. ;   move.l delaytime,d1
  551. ;   CALLDOS Delay      ;eine bestimmte Zeit warten
  552.  
  553.  
  554. * naechsten Schritt der Drehung des Polygramms berechnen
  555. * ------------------------------------------------------
  556.  
  557. *  Y - Drehung berechnen
  558. * -----------------------
  559.  
  560.    move.l stepycount,d0  ; YWinkel =YWinkel + stepy
  561.    move.l stepy,d1       ;==> beim naechsten Zeichnen um stepy Grad gedreht
  562.    CALLMATH SPAdd
  563.    move.l d0,stepycount
  564.  
  565. *  X - Drehung berechnen
  566. * -----------------------
  567.  
  568.  
  569.    move.l stepxcount,d0  ;Rotation um X-Achse
  570.    CALLMATHTRANS SPSin
  571.    move.l lyffp,d1   ;ry = SIN(stepxcount) * ly
  572.    CALLMATH SPMul
  573.    move.l d0,ryffp   ;Y-Radius der Ellipse veraendert sich Sinus-maessig
  574.                      ;         ==> Vortaeuschung einer richtigen Drehung
  575.                      ;             um X-Achse
  576.  
  577.    move.l stepxcount,d0
  578.    move.l PI,d1
  579.    CALLMATH SPCmp
  580.    bne    cont5
  581.    move.l stepx,d0    ;wenn bereits um 180° um X-Achse gedreht
  582.    CALLMATH SPNeg     ;
  583.    move.l d0,stepx    ;Schrittweite negieren
  584.                       ;==> wird wieder zurueckgedreht
  585.                       ;    trotzdem Effekt : Polygramm dreht sich weiter
  586.                       ;                      in die selbe Richtung
  587.  
  588.  
  589. cont5
  590.    move.l stepxcount,d0 ; XWinkel = XWinkel + stepx
  591.    move.l stepx,d1      ;==> beim naechsten Zeichnen um stepx Grad gedreht
  592.    CALLMATH SPAdd
  593.    move.l d0,stepxcount
  594.  
  595.  
  596. *  Z - Drehung berechnen
  597. * -----------------------
  598.  
  599.  
  600. contz
  601.    move.l stepzcount,d0     ;Rotation um Z-Achse
  602.    CALLMATHTRANS SPSin
  603.    move.l lxffp,d1    ;rx = SIN(stepxcount) * lx
  604.    CALLMATH SPMul     ;X-Radius der Ellipse veraendert sich Sinus-maessig
  605.    move.l d0,rxffp    ;         ==> Vortaeuschung einer richtigen Drehung
  606.                       ;             um Z-Achse
  607.  
  608.  
  609.  
  610.    move.l stepzcount,d0
  611.    move.l PI,d1
  612.    CALLMATH SPCmp
  613.    bne    cont6
  614.    move.l stepz,d0 ;wenn bereits um 180° um Z-Achse gedreht
  615.    CALLMATH SPNeg  ;Schrittweite negieren
  616.    move.l d0,stepz ;==> Polygramm wird wieder zurueckgedreht
  617.                    ;    trotzdem Effekt : Polygramm dreht sich weiter
  618.                    ;                      in die selbe Richtung
  619.  
  620. cont6
  621.    move.l stepzcount,d0
  622.    move.l stepz,d1
  623.    CALLMATH SPAdd       ; ZWinkel = ZWinkel + stepz
  624.    move.l d0,stepzcount ;==> beim naechsten Zeichnen um stepz Grad gedreht
  625.  
  626.  
  627. *  Ende des Berechnens des neuen Polygramms
  628. *  ----------------------------------------
  629. *  altes Polygramm wieder loeschen
  630. *  ----------------------------------------
  631.  
  632.    lea.l OwnRastPort,a1
  633.    clr.l d0
  634.    CALLGRAF SetRast
  635.  
  636.    movea.l UPort,a0
  637.    CALLEXEC GetMsg           ;hole Message
  638.    tst.l d0
  639.    beq loop6                 ;wenn keine da weiter drehen
  640.  
  641.    movea.l   d0,a1           ;muss nach a1
  642.    CALLEXEC ReplyMsg         ;quittiere Msg in a1
  643.  
  644.  
  645. *    CCC  L     EEEE    AA    N    N  U   U  PPP
  646. *  C      L     EE     A  A   N N  N  U   U  P  P
  647. *  C      L     E     A AA A  N   NN  U   U  PPP
  648. *    CCC  LLLL  EEEE  A    A  N    N  UUUU   P
  649. *
  650.  
  651.  
  652. * Speicher fuer Vektor-Array freigeben
  653. * ------------------------------------
  654.    move.l n,d0
  655.    addq.l #1,d0
  656.    lsl.l #2,d0
  657.    movea.l VArray,a1
  658.    CALLEXEC FreeMem
  659.  
  660.  
  661. freeraster1
  662.    tst.l Buffer0
  663.    beq   freeraster2
  664.    move.l #384,d0
  665.    move.l #172,d1
  666.    movea.l Buffer0,a0
  667.    CALLGRAF FreeRaster       ;Bufferplane0 freigeben
  668.  
  669. freeraster2
  670.    tst.l Buffer1
  671.    beq   closewin
  672.    move.l #384,d0
  673.    move.l #172,d1
  674.    movea.l Buffer1,a0
  675.    CALLGRAF FreeRaster       ;Bufferplane1 freigeben
  676.  
  677.  
  678. * Fenster schliessen
  679. * ------------------
  680. closewin
  681.    movea.l stapel,a7
  682.    movea.l windowptr,a0
  683.    CALLINT  CloseWindow      ;Fenster schliessen
  684.  
  685.  
  686. * Libraries schliessen
  687. * --------------------
  688.  
  689. closemathtrans
  690.    movea.l stapel,a7
  691.    movea.l MathTransBase,a1
  692.    CALLEXEC CloseLibrary     ;mathtrans.library schliessen
  693.  
  694. closemath
  695.    movea.l stapel,a7
  696.    movea.l MathBase,a1
  697.    CALLEXEC CloseLibrary     ;mathffp.library schliessen
  698.  
  699. closegraf
  700.    movea.l stapel,a7
  701.    movea.l GfxBase,a1
  702.    CALLEXEC CloseLibrary     ;graphics.library schliessen
  703.  
  704. closeint
  705.    movea.l stapel,a7
  706.    movea.l IntBase,a1        ;intuition.library schliessen
  707.    CALLEXEC CloseLibrary
  708.  
  709. closedos
  710.    movea.l stapel,a7
  711.    movea.l DOSBase,a1        ;dos.library schliessen
  712.    CALLEXEC CloseLibrary
  713. abbruch
  714.    movea.l stapel,a7
  715.    clr.l d0
  716.    rts                       ;Rueckkehr ins CLI
  717.  
  718.  
  719.  
  720. **********************************************
  721. ;             Unterprogs
  722. **********************************************
  723.  
  724.  
  725. getwinkel
  726.    move.l d4,d0      ;n.Eck berechnen
  727.    CALLMATH SPFlt
  728.    move.l ALPHA,d1
  729.    CALLMATH SPMul
  730.    move.l stepycount,d1
  731.    CALLMATH SPAdd        ; ==> d0 =  ALPHA * Ecke + stepycount
  732.    rts
  733.  
  734. getxcoord
  735.    bsr.s  getwinkel
  736.    CALLMATHTRANS SPCos
  737.    move.l rxffp,d1
  738.    CALLMATH SPMul        ;d0 = rx * COS(ALPHA * Ecke + stepycount)
  739.    move.l xposffp,d1     ;d0 = xpos + rx*COS(ALPHA * Ecke + stepycount)
  740. gemeinsames
  741.    CALLMATH SPAdd
  742.    CALLMATH SPFix     ;Koordinate von FFP nach normal wandeln
  743.    move.w d0,(a2)+    ;in VArray eintragen
  744.    rts
  745.  
  746. getycoord
  747.    bsr  getwinkel
  748.    CALLMATHTRANS SPSin
  749.    move.l ryffp,d1
  750.    CALLMATH SPMul      ;d0 = rx * SIN(ALPHA * Ecke + stepycount)
  751.    move.l yposffp,d1   ;d0 = xpos + rx*COS(ALPHA * Ecke + stepycount)
  752.    bra.s  gemeinsames
  753.  
  754.  
  755.  
  756. ************************************************************
  757. *
  758. *          Sonstiges.........
  759.  
  760. ;
  761. ; Konvertiere d2.l in ASCII-String ab (a0)
  762. ;
  763.  
  764. hexasc
  765.     moveq.l #7,d0                       ;8 Nibble (=Halbbyte) wandeln
  766.     addq.l  #8,a0                       ;Pos der letzten Stelle im Buffer+1
  767. loop5
  768.     moveq   #15,d1                      ;
  769.     and.l   d2,d1                       ;1 Nibble isolieren
  770.     asr.l   #4,d2                       ;naechstes Nibble an 1.Pos
  771.     addi.b  #48,d1                      ;isol. Nibble+48=Zahl in ASCII
  772.     cmpi.b  #57,d1                      ;war Zahl >9 ?
  773.     bls.s   cont4
  774.     addq.l  #7,d1                       ;wenn ja noch 7 dazu ==> A-F
  775. cont4
  776.     move.b  d1,-(a0)                    ;in Buffer eintragen
  777.     dbra    d0,loop5                    ;naechstes Nibble wandeln
  778.     rts
  779.  
  780. nomath
  781.     move.l OutHandle,d1
  782.     move.l #Fehler1,d2   ;keine mathffp.library
  783.     moveq.l #len1,d3     ;(sehr unwahrscheinlich ,da im ROM)
  784.     CALLDOS Write
  785.     bra    closegraf
  786.  
  787. nomathtrans
  788.     move.l OutHandle,d1
  789.     move.l #Fehler2,d2    ;keine mathtrans.library im LIBS:
  790.     moveq.l #len2,d3
  791.     CALLDOS Write
  792.     bra    closemath
  793.  
  794. nomem
  795.     move.l OutHandle,d1
  796.     move.l #Fehler3,d2    ;nicht genuegend Speicher
  797.     moveq.l #len3,d3
  798.     CALLDOS Write
  799.     bra    freeraster1
  800.  
  801.  
  802.  
  803.     DATA constants
  804.  
  805.  
  806. W_Gadgets equ   WINDOWDRAG!WINDOWDEPTH!WINDOWCLOSE
  807. W_Extras  equ   SMART_REFRESH!ACTIVATE
  808.  
  809.  
  810.  
  811. windowdef
  812.         dc.w    0,0                 ;links, oben
  813.         dc.w    630,240             ;Breite, Hoehe
  814.         dc.b    -1,-1               ;Pens des Screen
  815.         dc.l    CLOSEWINDOW
  816.         dc.l    W_Gadgets!W_Extras  ;Window Flags
  817.         dc.l    0                   ;erstes User-Gadget
  818.         dc.l    0                   ;keine User-Checkmark
  819.         dc.l    W_Title             ;Titel des Window
  820.         dc.l    0                   ;kein eigener Screen
  821.         dc.l    0                   ;keine Super Bitmap
  822.         dc.w    100,20              ;Min. Groesse
  823.         dc.w    640,200             ;Max.
  824.         dc.w    WBENCHSCREEN        ;Use Workbench Screen
  825.  
  826.         cnop 0,2
  827. W_Title dc.b    'Polygramm Demo  by   Sascha Groening',0
  828.         cnop 0,2
  829. Fehler1 dc.b 'no mathffp.library',10
  830. len1    equ *-Fehler1
  831.         cnop 0,2
  832. Fehler2 dc.b 'no mathtrans.library',10
  833. len2    equ *-Fehler2
  834.         cnop 0,2
  835. Fehler3 dc.b 'Kauf Dir endlich eine Speichererweiterung !!',10
  836. len3    equ *-Fehler3
  837.         cnop 0,2
  838.  
  839.  
  840.  
  841.  cnop 0,2
  842. msg           dc.b  'Hello,World!YeahYeahYeahYeahYeahHello,World!YeahYeahYeahYeahYeah'
  843. msglen        equ   *-msg
  844.  cnop 0,2
  845.  
  846.  dc.b 'Polygramm-Demo  by Sascha Groening',10
  847.  dc.b 'This is Public Domain !! Do with it whatever you like !!',10
  848.  
  849.  cnop 0,2
  850. dosname    dc.b 'dos.library',0
  851.  cnop 0,2
  852. intname    dc.b 'intuition.library',0
  853.  cnop 0,2
  854. grafname   dc.b 'graphics.library',0
  855.  cnop 0,2
  856. mathname   dc.b 'mathffp.library',0
  857.  cnop 0,2
  858. mathtransname dc.b 'mathtrans.library',0
  859.  cnop 0,2
  860.  
  861.   cnop 0,4
  862.  
  863. n dc.l 9           ;Anzahl der Ecken
  864.                     ;muss eine ungerade Zahl sein !!!!
  865.  
  866. rx dc.l 100         ; X-Radius der Ellipse
  867. ry dc.l 50          ; Y-Radius der Ellipse
  868.  
  869. xpos dc.l 180       ; Mittelpunkt der Ellipse
  870. ypos dc.l 72        ; bei (180/72)
  871.  
  872. stepz dc.l 3        ; Drehung in 3° Schritten um Z-Achse
  873. stepy dc.l 3        ; keine Drehung um Y-Achse
  874. stepx dc.l 0        ; keine Drehung um X-Achse
  875.  
  876. delaytime dc.l 8    ; Verzoegerungszeit = 8/50 sec
  877.   cnop 0,4
  878. destx dc.w 20       ; (x/y) Koord des linken oberen Eckes des
  879. desty dc.w 28       ; Windowausschnitts ,in den immer wieder
  880.                     ; die Bufferplane mit fertig gezeichneten
  881.                     ; Polygramm kopiert wird.
  882.   cnop 0,4
  883. OwnBitMap                   ;eigene BitmapStrktr fuer Bufferplanes
  884.   dc.w 48  ;Bytes per Row
  885.   dc.w 172 ;Rows
  886.   dc.b 0 ;flags
  887.   dc.b 2 ;depth     ;==> 2 Planes
  888.   dc.w 0 ;pad
  889. Buffer0  ds.l 1     ;BufferPlane0
  890. Buffer1  ds.l 1     ;BufferPlane1
  891.  
  892.  
  893.   BSS storage
  894.  
  895. DOSBase ds.l 1
  896. OutHandle ds.l 1
  897. IntBase ds.l 1
  898. GfxBase ds.l 1
  899. MathBase ds.l 1
  900. MathTransBase ds.l 1
  901. windowptr ds.l 1
  902. stapel ds.l 1
  903. hbuf ds.l 3
  904. RPort ds.l 1
  905. UPort ds.l 1
  906. Plane0 ds.l 1
  907. Plane1 ds.l 1
  908. DestBitMap ds.l 1
  909. PI ds.l 1
  910. PI2 ds.l 1
  911. ALPHA ds.l 1
  912. VArray ds.l 1
  913. argh ds.l 1
  914. two ds.l 1
  915. stepycount ds.l 1
  916. stepzcount ds.l 1
  917. stepxcount ds.l 1
  918. lyffp ds.l 1
  919. lxffp ds.l 1
  920. einsachtzig ds.l 1
  921. rxffp ds.l 1
  922. ryffp ds.l 1
  923. xposffp ds.l 1
  924. yposffp ds.l 1
  925. OwnRastPort ds.b 100  ;uninitialisierte RastPortStrktr
  926.  
  927.    END
  928.